home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / diskmags / 0022-3.564 / dmg-3459 / programs / gfa_trix / foob.lst < prev    next >
File List  |  1992-11-13  |  4KB  |  101 lines
  1. ' INLINE example source stuff by Richard Karsmakers
  2. '
  3. ' INLINEs may be loaded by pressing HELP on the INLINE command, then "L" (Load)
  4. '
  5. ' The INLINE below must, after merged in your program, be given the FOOB.INL file!
  6. INLINE haal%,36
  7. ' The following INLINE must be fed the converted text (.INL) file
  8. ' The '300' value needs to vary according the length of your file
  9. INLINE fetch%,300
  10. '
  11. ALERT 1,CHAR{@fetch(1)},1,"OK",d%
  12. PRINT AT(10,10);CHAR{@fetch(1)}
  13. '
  14. FUNCTION fetch(no%)
  15.   DIM ddcr%(15)                               !Dimension register array
  16.   ddcr%(0)=no%                                !Number of text in D0
  17.   ddcr%(8)=fetch%                             !Address of INLINE text cluster
  18.   RCALL haal%,ddcr%()                         !Do it. haal% is FOOB.INL
  19.   het%=ddcr%(8)                               !A0 now contains the string address
  20.   ERASE ddcr%()                               !Get rid of array
  21.   RETURN het%                                 !Give address back
  22. ENDFUNC
  23. PROCEDURE alg_to_inl
  24.   FILESELECT "A:\*.*","",lees$                !Get the .TXT file
  25.   schrijf$=LEFT$(lees$,LEN(lees$)-3)+"INL"    !Create .INL file name
  26.   OPEN "I",#1,lees$                           !Open the original text file
  27.   s%=LOF(#1)                                  !Length of source file
  28.   OPEN "O",#2,schrijf$                        !Open the target (.INL) file
  29.   l%=0                                        !Length of target file
  30.   t%=0                                        !Current position in source file
  31.   WHILE t%<s%
  32.     byte|=INP(#1)
  33.     INC t%
  34.     IF CHR$(byte|)="~"                        !Text number indicator found
  35.       OUT #2,0                                !End previous text
  36.       INC l%
  37.       IF ODD(l%)                              !If odd, then even it out
  38.         OUT #2,0                              ! with another zero
  39.         INC l%
  40.       ENDIF
  41.       nummer$=SPACE$(3) !Calculate the number
  42.       MID$(nummer$,1,1)=CHR$(INP(#1))
  43.       MID$(nummer$,2,1)=CHR$(INP(#1))
  44.       MID$(nummer$,3,1)=CHR$(INP(#1))
  45.       shit|=INP(#1)                           !Skip line feed and return
  46.       shit|=INP(#1)
  47.       ADD t%,5
  48.       nummer$=MKI$(VAL(nummer$))
  49.       PRINT #2,nummer$;                       !Write it
  50.       ADD l%,2
  51.     ELSE IF byte|=&HD
  52.       shit|=INP(#1)                           !Skip return
  53.       INC t%
  54.     ELSE IF byte|=34                          !"
  55.       ' do nothing
  56.     ELSE
  57.       OUT #2,byte|                            !No text indicator found,
  58.       INC l%                                  ! so it's a standard character
  59.     ENDIF
  60.   WEND
  61.   OUT #2,&HFF
  62.   OUT #2,&HFF
  63.   OUT #2,&HFF
  64.   CLOSE #1
  65.   CLOSE #2
  66.   OPEN "I",#1,schrijf$
  67.   CLS
  68.   PRINT "Length of .INL file is ";LOF(#1)
  69.   CLOSE #1
  70.   a%=INP(2)                                   !Wait for a key
  71. RETURN
  72. '
  73. ' Real exist
  74. '
  75. ' Syntax example:
  76. ' @search_file("A:\YEAH\SURE.PRG")
  77. ' The result will be in exist! (TRUE if found, FALSE if not)
  78. '
  79. PROCEDURE search_file(filename$)
  80.   LOCAL adr%
  81.   adr%=VARPTR(filename$)           !Give name to GEMDOS
  82.   IF GEMDOS(78,L:adr%,0)<0         !Do GEMDOS exist
  83.     exist!=FALSE                   !Not found
  84.   ELSE
  85.     exist!=TRUE                    !Found
  86.   ENDIF
  87. RETURN
  88. '
  89. ' Routine to get the name of your current program file
  90. '
  91. ' Just call the routine. The name will be in NAM$)
  92. '
  93. PROCEDURE shel_read
  94.   nam$=SPACE$(200)                        !Buffer for actual name
  95.   cmd$=SPACE$(200)                        !Buffer for command
  96.   LPOKE ADDRIN,V:nam$                     !Tell GEMSYS these addresses
  97.   LPOKE ADDRIN+4,V:cmd$
  98.   GEMSYS 120                              !This function is called "SHELL_READ"
  99.   nam$=LEFT$(nam$,INSTR(nam$,CHR$(0))-1)  !Get rid of needless trash
  100. RETURN
  101.